home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Borland / Borland Pascal with Objects 7.0 / UTILDEMO.ZIP / PRNFLTR.PAS < prev    next >
Pascal/Delphi Source File  |  1992-10-27  |  13KB  |  498 lines
  1. {************************************************}
  2. {                                                }
  3. {   Printer output filter exammple               }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. program PrinterOutputFilter;
  9.  
  10. { Printer filters read input from the IDE by way of StdIn (by using Read
  11.   or ReadLn). It then converts the syntax highlight codes inserted into
  12.   the text into appropriate printer command codes.  This converted text is
  13.   then output Lst (which defaults to LPT1).
  14.  
  15.   The syntax highlight codes are in the form of <ESC>#, where '#' is an
  16.   ASCII digit from 1($31) to 8($38).  The last code sent remains in effect
  17.   until another code is found.  The following is a list of the codes and
  18.   what type of text they represent:
  19.  
  20.       1  -  Whitespace    (space, tab)
  21.       2  -  Comment
  22.       3  -  Reserved word (begin, end, procedure, etc...)
  23.       4  -  Identifier    (Writeln, Reset, etc...)
  24.       5  -  Symbol        (;, :, ., etc...)
  25.       6  -  String        ('string', #32, #$30)
  26.       7  -  Number        (24, $56)
  27.       8  -  Assembler     (asm mov ax,5 end;)
  28.  
  29.   The following printers are supported:
  30.  
  31.      EPSON and compatibles
  32.  
  33.      HP LaserJet II, III, IIP, IID, IIID, IIISi and compatibles
  34.        (Italics are available on IIIx, IIP)
  35.  
  36.      ADOBE(R) PostScript(R)
  37.  
  38.      ASCII (simply strips the highlight codes before sending to Lst)
  39.  
  40.   Command line options:
  41.  
  42.      /EPSON   - Output EPSON printer codes
  43.      /HP      - Output HP LaserJet codes
  44.      /PS      - Output PostScript
  45.      /ASCII   - Strip highlight codes (Default)
  46.  
  47.      /Lxx     - Lines per page (Default 55)
  48.      /Txx     - Tabsize (Default 8)
  49.      /O[file] - Output to file or device (Default LPT1)
  50. }
  51.  
  52. {$M 2048, 0, 0}
  53. {$I-,S-,X+}
  54.  
  55. const
  56.   MaxAttributes = 8;
  57.  
  58. type
  59.   TPCharArray = array[0..16380] of PChar;
  60.   PPCharArray = ^TPCharArray;
  61.  
  62.   PPrinterCodes = ^TPrinterCodes;
  63.   TPrinterCodes = record
  64.       { Number of preamble strings in the Preamble array. }
  65.     PreambleCount: Byte;
  66.       { Pointer to an array of PChars that define the preamble sequence for
  67.         this printer. Sent at the start of a print job. }
  68.     Preamble: PPCharArray;
  69.       { Pointer to an array of PChars that define the code sequences for
  70.         changing the current attribute. }
  71.     CodeArray: PPCharArray;
  72.       { Array of indexes into the CodeArray corresponing to attributes
  73.         supported for this printer. }
  74.     Attributes: array[0..MaxAttributes - 1] of Byte;
  75.       { Codes sent at the start of a page. }
  76.     StartPage: PChar;
  77.       { Codes sent at the end of a page. }
  78.     EndPage: PChar;
  79.       { Codes sent at the end of a line. }
  80.     EndLine: PChar;
  81.       { Codes sent at the end of the print job. }
  82.     Postamble:  PChar;
  83.   end;
  84.  
  85. const
  86.  
  87.   { EPSON Printer code definition }
  88.  
  89.   EpsonItalic   = #27'4';
  90.   EpsonNoItalic = #27'5';
  91.   EpsonBold     = #27'E';
  92.   EpsonNoBold   = #27'F';
  93.   EpsonULine    = #27'-'#1;
  94.   EpsonNoULine  = #27'-'#0;
  95.  
  96.   EpsonCodeArray: array[0..7] of PChar = (
  97.     EpsonBold,
  98.     EpsonNoBold,
  99.     EpsonItalic,
  100.     EpsonNoItalic,
  101.     EpsonULine,
  102.     EpsonNoULine,
  103.     EpsonBold + EpsonItalic,
  104.     EpsonNoBold + EpsonNoItalic);
  105.  
  106.   EpsonCodes: TPrinterCodes = (
  107.     PreambleCount: 0;
  108.     Preamble: nil;
  109.     CodeArray: @EpsonCodeArray;
  110.     Attributes: (
  111.       0,        { Whitespace }
  112.       2,        { Comment }
  113.       1,        { Reserved word }
  114.       0,        { Identifier }
  115.       0,        { Symbol }
  116.       4,        { String }
  117.       0,        { Number }
  118.       1);       { Assembler }
  119.     StartPage: '';
  120.     EndPage: #12;
  121.     EndLine: #13#10;
  122.     Postamble: ''
  123.   );
  124.  
  125.   { HP LaserJet code definition }
  126.  
  127.   HPInit      = #27'E'#27'(10U'#27'&k0S'#27'(s3T';
  128.   HPItalic    = #27'(s1S';
  129.   HPNoItalic  = #27'(s0S';
  130.   HPBold      = #27'(s3B';
  131.   HPNoBold    = #27'(s0B';
  132.   HPULine     = #27'&dD';
  133.   HPNoULine   = #27'&d@';
  134.  
  135.   HPCodeArray: array[0..7] of PChar = (
  136.     HPBold,
  137.     HPNoBold,
  138.     HPItalic,
  139.     HPNoItalic,
  140.     HPULine,
  141.     HPNoULine,
  142.     HPBold + HPItalic,
  143.     HPNoBold + HPNoItalic);
  144.  
  145.   LaserJetPreamble: PChar = HPInit;
  146.   LaserJetCodes: TPrinterCodes = (
  147.     PreambleCount: 1;
  148.     Preamble: @LaserJetPreamble;
  149.     CodeArray: @HPCodeArray;
  150.     Attributes: (
  151.       0,        { Whitespace }
  152.       2,        { Comment }
  153.       1,        { Reserved word }
  154.       0,        { Identifier }
  155.       0,        { Symbol }
  156.       4,        { String }
  157.       0,        { Number }
  158.       1);       { Assembler }
  159.     StartPage: '';
  160.     EndPage: #12;
  161.     EndLine: #13#10;
  162.     Postamble: #12
  163.   );
  164.  
  165.   { Raw ASCII definition }
  166.  
  167.   AsciiCodes: TPrinterCodes = (
  168.     PreambleCount: 0;
  169.     Preamble: nil;
  170.     CodeArray: nil;
  171.     Attributes: (
  172.       0,        { Whitespace }
  173.       0,        { Comment }
  174.       0,        { Reserved word }
  175.       0,        { Identifier }
  176.       0,        { Symbol }
  177.       0,        { String }
  178.       0,        { Number }
  179.       0);       { Assembler }
  180.     StartPage: '';
  181.     EndPage: #12;
  182.     EndLine: #13#10;
  183.     Postamble: ''
  184.   );
  185.  
  186.   { PostScript code definition }
  187.  
  188.   PSPreamble0  = #4'%!PS-Adobe-3.0'#13#10+
  189.                 'initgraphics'#13#10;
  190.   PSPreamble1  = '/fnr /Courier findfont 10 scalefont def'#13#10;
  191.   PSPreamble2  = '/fni /Courier-Oblique findfont 10 scalefont def'#13#10;
  192.   PSPreamble3  = '/fnb /Courier-Bold findfont 10 scalefont def'#13#10;
  193.   PSPreamble4  = '/fnbi /Courier-BoldOblique findfont 10 scalefont def'#13#10;
  194.   PSPreamble5  = '/newl {20 currentpoint exch pop 12 sub moveto} def'#13#10+
  195.                  '/newp {20 765 moveto} def'#13#10+
  196.                  'fnr setfont'#13#10;
  197.   PSNormal     = 'fnr setfont'#13#10;
  198.   PSItalic     = 'fni setfont'#13#10;
  199.   PSBold       = 'fnb setfont'#13#10;
  200.   PSBoldItalic = 'fnbi setfont'#13#10;
  201.  
  202.   PSCodeArray: array[0..5] of PChar = (
  203.     PSBold,
  204.     PSNormal,
  205.     PSItalic,
  206.     PSNormal,
  207.     PSBoldItalic,
  208.     PSNormal);
  209.  
  210.   PSPreamble: array[0..5] of PChar = (
  211.     PSPreamble0,
  212.     PSPreamble1,
  213.     PSPreamble2,
  214.     PSPreamble3,
  215.     PSPreamble4,
  216.     PSPreamble5);
  217.   PSCodes: TPrinterCodes = (
  218.     PreambleCount: High(PSPreamble) - Low(PSPreamble) + 1;
  219.     Preamble: @PSPreamble;
  220.     CodeArray: @PSCodeArray;
  221.     Attributes: (
  222.       0,        { Whitespace }
  223.       2,        { Comment }
  224.       1,        { Reserved word }
  225.       0,        { Identifier }
  226.       0,        { Symbol }
  227.       3,        { String }
  228.       0,        { Number }
  229.       1);       { Assembler }
  230.     StartPage: 'newp'#13#10;
  231.     EndPage: 'showpage'#13#10;
  232.     EndLine: 'newl'#13#10;
  233.     Postamble: #4
  234.   );
  235.  
  236.   { Special case printer modes. This facilitates indicating a special case
  237.     printer such as PostScript }
  238.  
  239.   pmNormal     = $0001;
  240.   pmPostScript = $0002;
  241.  
  242.   PrintMode: Word = pmNormal;
  243.   LinesPerPage: Word = 55;
  244.   ToFile: Boolean = False;
  245.   TabSize: Word = 8;
  246.  
  247. var
  248.   C, LineCount, TabCount: Integer;
  249.   Line, OutputLine: String;
  250.   InputBuffer: array[0..4095] of Char;
  251.   PrinterCodes: PPrinterCodes;
  252.   CurCode, NewCode: Byte;
  253.   AKey: Word;
  254.   Lst: Text;
  255.  
  256. procedure UpStr(var S: String);
  257. var
  258.   I: Integer;
  259. begin
  260.   for I := 1 to Length(S) do S[I] := UpCase(S[I]);
  261. end;
  262.  
  263. { Checks whether or not the Text file is a device.  If so, it is forced to
  264.   "raw" mode }
  265.  
  266. procedure SetDeviceRaw(var T: Text); assembler;
  267. asm
  268.     LES    DI,T
  269.     MOV    BX,WORD PTR ES:[DI]
  270.     MOV    AX,4400H
  271.     INT    21H
  272.     TEST    DX,0080H
  273.     JZ    @@1
  274.     OR    DL,20H
  275.     MOV    DH,DH
  276.     MOV    AX,4401H
  277.     INT    21H
  278. @@1:
  279. end;
  280.  
  281. { Process the command line.  If any new printers are to be supported, simply
  282.   add a command line switch here. }
  283.  
  284. procedure ProcessCommandLine;
  285. var
  286.   Param: String;
  287.   I: Integer;
  288.  
  289.   function ParamVal(var P: String; Default: Word): Word;
  290.   var
  291.     N, E: Integer;
  292.   begin
  293.     Delete(P, 1, 1);
  294.     Val(P, N, E);
  295.     if E = 0 then
  296.       ParamVal := N
  297.     else
  298.       ParamVal := Default;
  299.   end;
  300.  
  301. begin
  302.   PrinterCodes := @AsciiCodes;
  303.   for I := 1 to ParamCount do
  304.   begin
  305.     Param := ParamStr(I);
  306.     if (Length(Param) >= 2) and ((Param[1] = '/') or (Param[1] = '-')) then
  307.     begin
  308.       Delete(Param, 1, 1);
  309.       UpStr(Param);
  310.       if Param = 'EPSON' then
  311.         PrinterCodes := @EpsonCodes
  312.       else if Param = 'HP' then
  313.         PrinterCodes := @LaserJetCodes
  314.       else if Param = 'ASCII' then
  315.         PrinterCodes := @AsciiCodes
  316.       else if Param = 'PS' then
  317.       begin
  318.         PrinterCodes := @PSCodes;
  319.         PrintMode := pmPostScript;
  320.       end
  321.       else if Param[1] = 'L' then
  322.         LinesPerPage := ParamVal(Param, LinesPerPage)
  323.       else if Param[1] = 'T' then
  324.         TabSize := ParamVal(Param, TabSize)
  325.       else if Param[1] = 'O' then
  326.       begin
  327.         Delete(Param, 1, 1);
  328.         Assign(Lst, Param);
  329.         Rewrite(Lst);
  330.         ToFile := True;
  331.         SetDeviceRaw(Lst);
  332.       end;
  333.     end;
  334.   end;
  335.   if not ToFile then
  336.   begin
  337.     Assign(Lst, 'LPT1');
  338.     Rewrite(Lst);
  339.     SetDeviceRaw(Lst);
  340.   end;
  341. end;
  342.  
  343. { Flush the currently assembled string to the output }
  344.  
  345. procedure PurgeOutputBuf;
  346. begin
  347.   if OutputLine = '' then Exit;
  348.   case PrintMode of
  349.     pmNormal: Write(Lst, OutputLine);
  350.     pmPostScript:
  351.     begin
  352.       Write(Lst, '(');
  353.       Write(Lst, OutputLine);
  354.       Write(Lst, ') show'#13#10);
  355.     end;
  356.   end;
  357.   OutputLine := '';
  358.   if IOResult <> 0 then Halt(1);
  359. end;
  360.  
  361. { Add the chracter to the output string.  Process special case characters
  362.   and tabs, purging the output buffer when nessesary }
  363.  
  364. procedure AddToOutputBuf(AChar: Char);
  365. var
  366.   I: Integer;
  367. begin
  368.   case AChar of
  369.     '(',')','\':
  370.     begin
  371.       case PrintMode of
  372.         pmPostScript:
  373.         begin
  374.           if Length(OutputLine) > 253 then
  375.             PurgeOutputBuf;
  376.           Inc(OutputLine[0]);
  377.           OutputLine[Length(OutputLine)] := '\';
  378.         end;
  379.       end;
  380.     end;
  381.     #9:
  382.     begin
  383.       if Length(OutputLine) > (255 - TabSize) then
  384.         PurgeOutputBuf;
  385.       for I := 1 to TabSize - (TabCount mod TabSize) do
  386.       begin
  387.         Inc(OutputLine[0]);
  388.         OutputLine[Length(OutputLine)] := ' ';
  389.       end;
  390.       Inc(TabCount, TabSize - (TabCount mod TabSize));
  391.       Exit;
  392.     end;
  393.   end;
  394.   if Length(OutputLine) > 254 then
  395.     PurgeOutputBuf;
  396.   Inc(OutputLine[0]);
  397.   OutputLine[Length(OutputLine)] := AChar;
  398.   Inc(TabCount);
  399. end;
  400.  
  401. { End the current page and start a new one }
  402.  
  403. procedure NewPage(const PCodes: TPrinterCodes);
  404. begin
  405.   PurgeOutputBuf;
  406.   Write(Lst, PCodes.EndPage);
  407.   Write(Lst, PCodes.StartPage);
  408.   LineCount := 0;
  409.   TabCount := 0;
  410. end;
  411.  
  412. { End the current line }
  413.  
  414. procedure NewLine(const PCodes: TPrinterCodes);
  415. begin
  416.   PurgeOutputBuf;
  417.   Write(Lst, PCodes.EndLine);
  418.   Inc(LineCount);
  419.   TabCount := 0;
  420.   if LineCount > LinesPerPage then
  421.     NewPage(PCodes);
  422. end;
  423.  
  424. { Check for the presence of a keypressed and return it if available }
  425.  
  426. function GetKey(var Key: Word): Boolean; assembler;
  427. asm
  428.     MOV    AH,1
  429.     INT    16H
  430.     MOV    AL,0
  431.     JE    @@1
  432.     XOR    AH,AH
  433.     INT    16H
  434.     LES    DI,Key
  435.     MOV    WORD PTR ES:[DI],AX
  436.     MOV    AL,1
  437. @@1:
  438. end;
  439.  
  440. begin
  441.   SetTextBuf(Input, InputBuffer);
  442.   ProcessCommandLine;
  443.   LineCount := 0;
  444.   with PrinterCodes^ do
  445.   begin
  446.     if PreambleCount > 0 then
  447.       for C := 0 to PreambleCount - 1 do
  448.         Write(Lst, Preamble^[C]);
  449.     if IOResult <> 0 then Halt(1);
  450.     LineCount := 0;
  451.     CurCode := $FF;
  452.     TabCount := 0;
  453.     Write(Lst, StartPage);
  454.     Line := '';
  455.     while True do
  456.     begin
  457.       if (Line = '') and Eof then
  458.       begin
  459.         PurgeOutputBuf;
  460.         Break;
  461.       end;
  462.       ReadLn(Line);
  463.       if GetKey(AKey) and (AKey = $011B) then
  464.         Halt(1);
  465.       C := 1;
  466.       while C <= length(Line) do
  467.       begin
  468.         case Line[C] of
  469.           #27:
  470.             if (Line[C + 1] >= '1') and (Line[C + 1] <= '8') then
  471.             begin
  472.               NewCode := Attributes[Byte(Line[C + 1]) - $31];
  473.               if NewCode <> CurCode then
  474.               begin
  475.                 PurgeOutputBuf;
  476.                 if (CurCode > 0) and (CurCode < MaxAttributes) then
  477.                   Write(Lst, CodeArray^[(CurCode - 1) * 2 + 1]);
  478.                 if (NewCode > 0) and (NewCOde < MaxAttributes) then
  479.                   Write(Lst, CodeArray^[(NewCode - 1) * 2]);
  480.                 CurCode := NewCode;
  481.               end;
  482.               Inc(C);
  483.             end;
  484.           #12: NewPage(PrinterCodes^);
  485.         else
  486.           AddToOutputBuf(Line[C]);
  487.         end;
  488.         Inc(C);
  489.       end;
  490.       NewLine(PrinterCodes^);
  491.     end;
  492.     if LineCount > 0 then
  493.       Write(Lst, EndPage);
  494.     Write(Lst, Postamble);
  495.   end;
  496.   Close(Lst);
  497. end.
  498.